home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr36 / lod370e.zip / PROGRAMR.ZIP / EMSALLOC.PAS next >
Pascal/Delphi Source File  |  1992-12-12  |  13KB  |  467 lines
  1. unit emsalloc;
  2.  
  3. { EMS Memory interface unit. This unit is used to allow for transparent      }
  4. { usage of EMS for certain variables using the EAADDR and EAALLOC functions. }
  5. { Make sure to call EAINIT with the proper parameters (I use                 }
  6. { EAINIT(4,20,true) myself) before using EAADDR or EAALLOC.                  }
  7. {                                                                            }
  8. { Note: Some of the lower level code came from one of Borland's Turbo Pascal }
  9. {       example programs.                                                    }
  10. {                                                                            }
  11. { Scott M. Baker, August 1992                                                }
  12.  
  13. interface
  14.  
  15. uses dos;
  16.  
  17. function emm_installed: boolean;
  18. Function EMS_Pages_Available(Var Total_EMS_Pages,Pages_Available: Word): Word;
  19. Function Allocate_Expanded_Memory_Pages(Pages_Needed: Word; Var Handle: Word): Word;
  20. Function Map_Expanded_Memory_Pages(Handle,Logical_Page,Physical_Page: Word): Word;
  21. Function Get_Page_Frame_Base_Address(Var Page_Frame_Address: Word): Word;
  22. Function Deallocate_Expanded_Memory_Pages(Handle: Word): Word;
  23. Function Get_Version_Number(Var Version_String: string): Word;
  24.  
  25. type
  26.  {$IFDEF DPMI}
  27.  EAPointer=pointer;
  28.  EAAddr=pointer;
  29.  {$ELSE}
  30.  EAPointer=array[1..3] of byte;
  31.  {$ENDIF}
  32. const
  33.  EAemsavail: boolean = false;
  34. var
  35.  EAemshandle: word;
  36.  EAexitsave: pointer;
  37.  EAemstotal: word;
  38.  EAemsused: word;
  39.  EAphypagemap: array[0..3] of word;
  40.  EAPageLocked: array[0..3] of word;
  41.  EApageaddr: array[0..255] of word;
  42.  EAphyacc: array[0..3] of longint;
  43.  EAphyacccount: longint;
  44.  EAframebase: longint;
  45.  EAconvmemused: longint;
  46.  EAemsmemused: longint;
  47.  
  48. procedure EAinit(minpage,maxpage: word; tryems: boolean);
  49. procedure EAAlloc(var p: EApointer; size: word);
  50. {$IFNDEF DPMI}
  51. function EAAddr(var p: eapointer): pointer;
  52. {$ENDIF}
  53. function EAEmsLeft: longint;
  54. procedure EABlockRead(var FilVar: file; Dest: EAPointer; numbytes: word);
  55. procedure EABlockWrite(var FilVar: file; Dest: EAPointer; numbytes: word);
  56. procedure EAlockvar(p: eapointer);
  57. procedure EAunlockvar(p: eapointer);
  58. function EAisnil(p: eapointer): boolean;
  59.  
  60. Const
  61.   EMM_INT                   = $67;
  62.   DOS_Int                   = $21;
  63.   GET_PAGE_FRAME            = $41;
  64.   GET_UNALLOCATED_PAGE_COUNT= $42;
  65.   ALLOCATE_PAGES            = $43;
  66.   MAP_PAGES                 = $44;
  67.   DEALLOCATE_PAGES          = $45;
  68.   GET_VERSION               = $46;
  69.  
  70.   STATUS_OK                 = 0;
  71.  
  72. implementation
  73.  
  74.  
  75. {---------------------------------------------------------}
  76. { The function Emm_Installed checks to see if the Expanded
  77.   Memory Manager (EMM) is loaded in memory. It does this by
  78.   looking for the string 'EMMXXXX0', which should be located
  79.   at 10 bytes from the beginning of the code segment pointed
  80.   to by the EMM interrupt, 67h                            }
  81.  
  82.  
  83. Function Emm_Installed: Boolean;
  84. Var
  85.  Emm_Device_Name       : string[8];
  86.  Int_67_Device_Name    : string[8];
  87.  Position              : Word;
  88.  Regs                  : registers;
  89. Begin
  90.  Int_67_Device_Name:='';
  91.  Emm_Device_Name   :='EMMXXXX0';
  92.  with Regs do Begin
  93.  
  94.   { Get the code segment pointed to by Interrupt 67h, the EMM
  95.     interrupt by using DOS call $35, 'get interrupt vector'     }
  96.  
  97.   AH:=$35;
  98.   AL:=EMM_INT;
  99.   Intr(DOS_int,Regs);
  100.  
  101.   { The ES pseudo-register contains the segment address pointed
  102.     to by Interrupt 67h }
  103.   { Create an 8 character string from the 8 successive bytes
  104.     pointed to by ES:$0A (10 bytes from ES)                   }
  105.  
  106.   For Position:=0 to 7 do Int_67_Device_Name:=Int_67_Device_Name+Chr(mem[ES:Position+$0A]);
  107.   Emm_Installed:=True;
  108.  
  109.   { Is it the EMM manager signature, 'EMMXXXX0'? then EMM is
  110.     installed and ready for use, if not, then the EMM manager
  111.     is not present                                            }
  112.  
  113.  
  114.   If Int_67_Device_Name<>Emm_Device_Name then Emm_Installed:=False;
  115.  end;
  116. end;
  117.  
  118. {---------------------------------------------------------}
  119. { This function returns the total number of EMS pages present
  120.   in the system, and the number of EMS pages that are
  121.   available for our use                                       }
  122.  
  123. Function EMS_Pages_Available(Var Total_EMS_Pages,Pages_Available: Word): Word;
  124. Var
  125.  Regs: Registers;
  126. Begin
  127.  with Regs do Begin
  128.   AH:=Get_Unallocated_Page_Count;
  129.   intr(EMM_INT,Regs);
  130.   Pages_Available:=BX;
  131.   Total_EMS_Pages:=DX;
  132.   EMS_Pages_Available:=AH
  133.  end;
  134. end;
  135.  
  136. {---------------------------------------------------------}
  137. { This function requests the desired number of pages from the
  138.   EMM                                                         }
  139.  
  140. Function Allocate_Expanded_Memory_Pages(Pages_Needed: Word; Var Handle: Word): Word;
  141. Var
  142.  Regs: Registers;
  143. Begin
  144.  with Regs do Begin
  145.   AH:= Allocate_Pages;                { Put the desired number of pages in BX}
  146.   BX:=Pages_Needed;
  147.   intr(EMM_INT,Regs);
  148.   handle:=dx;                         { EMS handle returned in DX            }
  149.   Allocate_Expanded_Memory_Pages:=AH; { Error code in AH                     }
  150.  end;
  151. end;
  152.  
  153. {---------------------------------------------------------}
  154. { This function maps a logical page onto one of the physical
  155.   pages made available to us by the
  156.   Allocate_Expanded_Memory_Pages function                     }
  157.  
  158. Function Map_Expanded_Memory_Pages(Handle,Logical_Page,Physical_Page: Word): Word;
  159. Var
  160.  Regs: Registers;
  161. Begin
  162.  with Regs do Begin
  163.   AH:=Map_Pages;
  164.   AL:=Physical_Page;
  165.   BX:=Logical_Page;
  166.   DX:=Handle;
  167.   Intr(EMM_INT,Regs);
  168.   Map_Expanded_Memory_Pages:=AH;
  169.  end;
  170. end;
  171.  
  172. {---------------------------------------------------------}
  173. { This function gets the physical address of the EMS page
  174.   frame we are using. The address returned is the segment
  175.   of the page frame.                                          }
  176.  
  177. Function Get_Page_Frame_Base_Address(Var Page_Frame_Address: Word): Word;
  178. Var
  179.  Regs: Registers;
  180. Begin
  181.  with Regs do Begin
  182.   AH:=Get_Page_Frame;
  183.   intr(EMM_INT,Regs);
  184.   Page_Frame_Address:=BX;
  185.   Get_Page_Frame_Base_Address:=AH;
  186.  end;
  187. end;
  188.  
  189. {---------------------------------------------------------}
  190. { This function releases the EMS memory pages allocated to
  191.     us, back to the EMS memory pool.                            }
  192.  
  193. Function Deallocate_Expanded_Memory_Pages(Handle: Word): Word;
  194. Var
  195.  Regs: Registers;
  196. Begin
  197.  with Regs do Begin
  198.   AH:=DEALLOCATE_PAGES;
  199.   DX:=Handle;
  200.   Intr(EMM_INT,Regs);
  201.   Deallocate_Expanded_Memory_Pages:=AH;
  202.  end;
  203. end;
  204.  
  205. {---------------------------------------------------------}
  206. { This function returns the version number of the EMM as
  207.   a 3 character string.                                       }
  208.  
  209. Function Get_Version_Number(Var Version_String: string): Word;
  210. Var
  211.  Regs: Registers;
  212.  Word_Part,Fractional_Part: Char;
  213. Begin
  214.  with Regs do Begin
  215.   AH:=GET_VERSION;
  216.   Intr(EMM_INT,Regs);
  217.   If AH=STATUS_OK then Begin
  218.    Word_Part   := Char( AL shr 4 + 48);
  219.    Fractional_Part:= Char( AL and $F +48);
  220.    Version_String:= Word_Part+'.'+Fractional_Part;
  221.   end;
  222.   Get_Version_Number:=AH;
  223.  end;
  224. end;
  225.  
  226. {$IFDEF DPMI}
  227.  
  228. procedure EAinit(minpage,maxpage: word; tryems: boolean);
  229. begin;
  230.  eaemsavail:=false;
  231.  eaemsused:=0;
  232.  eaconvmemused:=0;
  233.  eaemsmemused:=0;
  234. end;
  235.  
  236. procedure EAAlloc(var p: EApointer; size: word);
  237. begin;
  238.  getmem(p,size);
  239. end;
  240.  
  241. {function EAAddr(var p: eapointer): pointer;
  242. begin;
  243.  EaAddr:=p;
  244. end;}
  245.  
  246. procedure EAlockvar(p: eapointer);
  247. begin;
  248. end;
  249.  
  250. procedure EAunlockvar(p: eapointer);
  251. begin;
  252. end;
  253.  
  254. function EAisnil(p: eapointer): boolean;
  255. begin;
  256.  eaisnil:=(p=nil);
  257. end;
  258.  
  259. function EAEmsLeft: longint;
  260. begin;
  261.  EAEmsleft:=memavail;
  262. end;
  263.  
  264. procedure EABlockRead(var FilVar: file; Dest: EAPointer; numbytes: word);
  265. begin;
  266.  if filerec(filvar).recsize<>1 then halt;
  267.  blockread(filvar,dest^,numbytes);
  268. end;
  269.  
  270. procedure EABlockWrite(var FilVar: file; Dest: EAPointer; numbytes: word);
  271. var
  272.  temp: pointer;
  273. begin;
  274.  if filerec(filvar).recsize<>1 then halt;
  275.  blockwrite(filvar,dest^,numbytes);
  276. end;
  277.  
  278. {$ELSE}
  279.  
  280. procedure EAException(b: byte);
  281. var
  282.  a: byte;
  283.  c: word;
  284. begin;
  285.  runerror(255-b);
  286.  {1 size > 16384}
  287.  {2 no mem}
  288.  {3 internal error}
  289. end;
  290.  
  291. procedure ckerror(i: integer);
  292. begin;
  293.  if i<>0 then eaexception(3);
  294. end;
  295.  
  296. procedure EAcloseup; far;
  297. begin;
  298.  if EAemsavail then ckerror(deallocate_expanded_memory_pages(EAemshandle));
  299.  exitproc:=EAExitsave;
  300. end;
  301.  
  302. procedure EAinit(minpage,maxpage: word; tryems: boolean);
  303. var
  304.  emsavail: word;
  305.  w: word;
  306. begin;
  307.  eaemsavail:=false;
  308.  eaemsused:=0;
  309.  eaconvmemused:=0;
  310.  eaemsmemused:=0;
  311.  if tryems then begin;
  312.   EAEmsAvail:=EMM_Installed;
  313.   if EAemsavail=false then exit;
  314.   ckerror(ems_pages_available(EAemstotal,emsavail));
  315.   if minpage<4 then minpage:=4;
  316.   if (emsavail<minpage) then begin;
  317.    EAEmsAvail:=false;
  318.    exit;
  319.   end;
  320.   EAemsused:=emsavail;
  321.   if EAemsused>255 then EAemsused:=255;
  322.   if EAemsused>maxpage then EAemsused:=maxpage;
  323.   ckerror(allocate_expanded_memory_pages(EAemsused,EAemshandle));
  324.   ckerror(get_page_frame_base_address(w));
  325.   EAframebase:=longint(w)*16;
  326.   EAphypagemap[0]:=0; ckerror(map_expanded_memory_pages(EAemshandle,0,0));
  327.   EAphypagemap[1]:=1; ckerror(map_expanded_memory_pages(EAemshandle,1,1));
  328.   EAphypagemap[2]:=2; ckerror(map_expanded_memory_pages(EAemshandle,2,2));
  329.   EAphypagemap[3]:=3; ckerror(map_expanded_memory_pages(EAemshandle,3,3));
  330.   EAconvmemused:=0;
  331.   EAemsmemused:=0;
  332.   fillchar(EApageaddr,sizeof(EApageaddr),0);
  333.   fillchar(EAphyacc,sizeof(EAphyacc),0);
  334.   EAphyacccount:=0;
  335.   fillchar(EAPageLocked,sizeof(eapagelocked),0);
  336.  end;
  337.  EAexitsave:=exitproc;
  338.  exitproc:=@EAcloseup;
  339. end;
  340.  
  341. procedure EAAlloc(var p: EApointer; size: word);
  342. var
  343.  p2: pointer;
  344.  l: longint;
  345.  a,b: integer;
  346.  didems: boolean;
  347. begin;
  348.  didems:=false;
  349.  if EAemsavail then begin;
  350.   if size>16384 then EAexception(1);
  351.   b:=256;
  352.   for a:=0 to EAemsused-1 do if (longint(EApageaddr[a])+longint(size)<16380) and (b=256) then b:=a;
  353.   if b<>256 then begin;
  354.    p[1]:=(b or 128);
  355.    p[2]:=hi(EApageaddr[b]);
  356.    p[3]:=lo(EApageaddr[b]);
  357.    EApageaddr[b]:=EApageaddr[b]+size;
  358.    EAemsmemused:=EAemsmemused+size;
  359.    didems:=true;
  360.   end;
  361.  end;
  362.  if not didems then begin;
  363.   if memavail<size then EAexception(2);
  364.   getmem(p2,size);
  365.   l:=(longint(seg(p2^))*16) or ofs(p2^);
  366.   p[1]:=l div 65536;
  367.   p[2]:=(l mod 65536) div 256;
  368.   p[3]:=l mod 256;
  369.   EAconvmemused:=EAconvmemused+size;
  370.  end;
  371. end;
  372.  
  373. function EAAddr(var p: eapointer): pointer;
  374. var
  375.  l: longint;
  376.  p2: pointer;
  377.  a,b: integer;
  378.  lowest: longint;
  379.  pagenum: byte;
  380. begin;
  381.  if (p[1] and 128)<>0 then begin;
  382.   pagenum:=p[1] and 127;
  383.   if eaphypagemap[0]=pagenum then b:=0 else
  384.    if eaphypagemap[1]=pagenum then b:=1 else
  385.     if eaphypagemap[2]=pagenum then b:=2 else
  386.      if eaphypagemap[3]=pagenum then b:=3 else
  387.       b:=256;
  388.   if b=256 then begin;
  389.    lowest:=maxlongint;
  390.    b:=256;
  391.    for a:=0 to 3 do if (EAphyacc[a]<lowest) and (EAPageLocked[a]=0) then begin;
  392.     lowest:=EAphyacc[a];
  393.     b:=a;
  394.    end;
  395.    if b=256 then halt;
  396.    ckerror(map_expanded_memory_pages(EAemshandle,p[1] and 127,b));
  397.    EAphypagemap[b]:=pagenum;
  398.   end;
  399.   inc(EAphyacccount);
  400.   EAphyacc[b]:=EAphyacccount;
  401.  
  402.   l:=longint(p[2])*256+longint(p[3]);
  403.   l:=l+longint(EAframebase);
  404.   l:=l+longint(longint(16384)*longint(b));
  405.   p2:=ptr(l div 16,l mod 16);
  406.  end else begin;
  407.   l:=(longint(p[1])*65536)+(longint(p[2])*256)+(longint(p[3]));
  408.   p2:=ptr(l div 16,l mod 16);
  409.  end;
  410.  EAaddr:=p2;
  411. end;
  412.  
  413. procedure EAlockvar(p: eapointer);
  414. var
  415.  pagenum: byte;
  416. begin;
  417.  if (p[1] and 128)<>0 then begin;
  418.   pagenum:=p[1] and 127;
  419.   inc(EApagelocked[pagenum]);
  420.  end;
  421. end;
  422.  
  423. procedure EAunlockvar(p: eapointer);
  424. var
  425.  pagenum: byte;
  426. begin;
  427.  if (p[1] and 128)<>0 then begin;
  428.   pagenum:=p[1] and 127;
  429.   if eapagelocked[pagenum]>0 then dec(EApagelocked[pagenum]);
  430.  end;
  431. end;
  432.  
  433. function EAisnil(p: eapointer): boolean;
  434. begin;
  435.  eaisnil:=((p[1]=0) and (p[2]=0) and (p[3]=0));
  436. end;
  437.  
  438. function EAEmsLeft: longint;
  439. begin;
  440.  EAEmsleft:=(longint(EAemsused)*16384)-EAemsmemused;
  441. end;
  442.  
  443. procedure EABlockRead(var FilVar: file; Dest: EAPointer; numbytes: word);
  444. var
  445.  temp: pointer;
  446. begin;
  447.  if filerec(filvar).recsize<>1 then halt;
  448.  getmem(temp,numbytes);
  449.  blockread(filvar,temp^,numbytes);
  450.  move(temp^,EAAddr(dest)^,numbytes);
  451.  freemem(temp,numbytes);
  452. end;
  453.  
  454. procedure EABlockWrite(var FilVar: file; Dest: EAPointer; numbytes: word);
  455. var
  456.  temp: pointer;
  457. begin;
  458.  if filerec(filvar).recsize<>1 then halt;
  459.  getmem(temp,numbytes);
  460.  move(EAAddr(dest)^,temp^,numbytes);
  461.  blockwrite(filvar,temp^,numbytes);
  462.  freemem(temp,numbytes);
  463. end;
  464.  
  465. {$ENDIF}
  466.  
  467. end.